(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

open XNum
open UniTools
open UTypes
open Substitute
open GlyphMetric
open FontMetric
open Logging
open Dim
open Graphic
  
type index_position = | LeftIndex | RightIndex | VertIndex (* with sexp *)

type math_code =
  | NoMath
  | Ordinary
  | BinOp
  | Relation
  | Operator
  | Punct
  | Open
  | Close
  | Inner
  | SubScript
  | SuperScript
  | IndexPosition of index_position
 (* with sexp *)

type page_info = {
  pi_width     : num;
  pi_height    : num;
  pi_page_no   : int;
  pi_old_marks : (uc_string * uc_string) list;
  pi_new_marks : (uc_string * uc_string) list
} (* with sexp *)

type 'a basic_box = {
  b_width    : dim;
  b_height   : dim;
  b_depth    : dim;
  b_contents : 'a
} (* with sexp *)

(* contents of a box *)
type box = contents_type basic_box

and contents_type =
  | EmptyBox
  | CharBox of glyph_desc * font_metric * glyph_text
  | GlueBox of bool * bool       (* GlueBox (implicit, discardable) *)
  | RuleBox
  | ImageBox of string
  | CompBox of gfx_cmd list
  | MathBox of math_code * box
  | BreakBox of num * bool * box list * box list * box list
  | CommandBox of box_cmd
  | ProcBox of (page_info -> (num * num) -> box -> gfx_cmd list)

and box_cmd =
    [
    | `GfxCmd of gfx_cmd
    | `ParCmd of par_cmd
    | `PageCmd of page_cmd
    | `Special of simple_cmd
    ]

and gfx_cmd =
    (dim, box) graphic_command

and par_cmd =
  | VInsert of bool * box list
  | CallParFunction of (int -> unit)

and floating = (uc_string * (extended_glyph_item list))

and page_cmd =
  | SetNextLayout of uc_string
  | SetMark of uc_string * uc_string
  | CallPageFunction of (page_info -> (num * num) -> unit)
  | Float of floating

and simple_glyph_item =
    (box, box) JustHyph.simple_glyph_item

and extended_glyph_item =
    (box, box) JustHyph.extended_glyph_item

(* with sexp_of *)

type glyph_composer = (font_metric, box, box) Substitute.glyph_composer (* with sexp_of *)

(* |log_box <box>| prints <box> in human readable form. *)
let rec log_box box =
  match box.b_contents with
    | CharBox (g, f, t) ->
        begin
          match t with
            | NoGlyphText -> log_uc_string (FontMetric.get_unicode f g)
            | GlyphText u -> log_uc_string (UniText.ints_of u)
            | ClusterContinuation -> ()
        end
    | GlueBox (i, _) -> if not i then log_string " "
    | BreakBox (_, h, _, _, _) -> log_string (if h then "-" else "|")
    | CompBox _ -> log_string "[]"
    | RuleBox -> log_string "[--]"
    | ImageBox f -> log_string "<"; log_string f; log_string ">"
    | EmptyBox -> ()
    | MathBox (_, b) -> log_box b
    | CommandBox _ -> log_string "[!]"
    | ProcBox _ -> log_string "[*]"
  

(* debugging aids *)

(* |long_dump_box <box>| and |short_dump_box <box>| print <box> in
   debugging form. *)

let rec long_dump_box box =
  let dump_dims box =
    begin
      log_string "(";
      log_dim box.b_width;
      log_string " x ";
      log_dim box.b_height;
      log_string " + ";
      log_dim box.b_depth;
      log_string ")";
    end
  in
    match box.b_contents with
      | CharBox (c, _, t) ->            (* FIX: glyph_text dumping. *)
          log_string "\n(char-box ";
          dump_dims box;
          log_string " ";
          begin
            match c with
              | Simple g -> log_int g
              | Undef -> log_string "<undef>"
              | _ -> log_string "<comp>"
          end;
          log_string " ";
          dump_glyph_text t
      | GlueBox (i, d) ->
          log_string "\n(glue-box ";
          dump_dims box;
          log_string (if i then " i " else " - ");
          log_string (if d then "d)" else "-)")
      | BreakBox (_, h, _, _, _) ->
          log_string "\n(break-box ";
          dump_dims box;
          if h then log_string " -)" else log_string " |)"
      | CompBox c ->
          log_string "\n(comp-box ";
          dump_dims box;
          List.iter
            begin
              fun cmd ->
                match cmd with
                  | Graphic.PutBox (_, _, b) -> long_dump_box b
                  | _ -> ()
            end
            c;
          log_string ")"
      | RuleBox -> log_string "\n(rule-box)"
      | ImageBox f ->
          log_string "\n(image-box ";
          dump_dims box;
          log_string " ";
          log_string f;
          log_string ")"
      | EmptyBox -> log_string "\n(empty-box)"
      | MathBox (_, b) ->
          log_string "\n(math-box ";
          dump_dims box;
          log_string " ";
          long_dump_box b;
          log_string ")"
      | CommandBox _ -> log_string "\n(cmd-box)"
      | ProcBox _ -> log_string "\n(proc-box)"
  
let short_dump_box box =
  match box.b_contents with
    | BreakBox (_, _, _, _, _) -> log_string "|"
    | GlueBox (true, _) -> log_string "/"
    | GlueBox (false, true) -> log_string "_"
    | GlueBox (false, false) -> log_string "~"
    | CharBox (c, f, t) ->
        begin
          match t with
            | NoGlyphText -> log_uc_string (FontMetric.get_unicode f c)
            | GlyphText u -> log_uc_string (UniText.ints_of u)
            | ClusterContinuation -> ()
        end
    | _ -> log_string "!"
  
let long_dump_box_list boxes =
  log_string "(box-list ";
  List.iter long_dump_box boxes;
  log_string ")\n"

let short_dump_box_list boxes =
  log_string ">";
  List.iter short_dump_box boxes;
  log_string "<\n"
  
let empty_box = {
  b_width = dim_zero;
  b_height = dim_zero;
  b_depth = dim_zero;
  b_contents = EmptyBox;
}

  
let is_empty_box box = box = empty_box
  
(*
  |is_real_box <box>| tests whether <box> contains typeset material or meta information.
*)
let is_real_box box =
  match box.b_contents with
      (* FIX: remove no-break element of BreakBox *)
    | EmptyBox | CommandBox _ | BreakBox (_, _, _, _, []) -> false
    | BreakBox (_, _, _, _, _) | CharBox (_, _, _) | GlueBox (_, _) | RuleBox |
          ImageBox _ | CompBox _ | ProcBox _ | MathBox (_, _) -> true
        
(* A character box contains one character. *)
let new_glyph_box glyph font text =
  let gm = FontMetric.get_glyph_metric font glyph in
    { b_width = fixed_dim gm.gm_width;
      b_height = fixed_dim gm.gm_height;
      b_depth = fixed_dim gm.gm_depth;
      b_contents = CharBox (glyph, font, text) }
  
let new_char_box char font text =
  new_glyph_box (FontMetric.get_glyph font char) font text
  
let is_char_box box =
  match box.b_contents with
    | CharBox _ -> true
    | _ -> false
  
(* A glue box is an empty box. The <implicit> flag marks glue which is
   inserted by the layout procedures, e.g., kerning. <discardable>
   indicates that the glue-box is to be removed if a line-break occurs
   immediately before it. A rule box basically is a black glue-box.
*)
let new_glue_box width height implicit discardable = {
  b_width = width;
  b_height = height;
  b_depth = dim_zero;
  b_contents = GlueBox (implicit, discardable);
}

(* FIX: support vertical kerning *)
let new_kern_box x _y =
  new_glue_box (fixed_dim x) dim_zero true true
  
let is_glue_box box =
  match box.b_contents with
    | GlueBox (_, _) -> true
    | _ -> false
  
let is_implicit_glue box =
  match box.b_contents with
    | GlueBox (i, _) -> i
    | _ -> false
  
let is_discardable_glue box =
  match box.b_contents with
    | GlueBox (_, d) -> d
    | _ -> false
  
let new_rule_box width height depth = {
  b_width = width;
  b_height = height;
  b_depth = depth;
  b_contents = RuleBox;
}
  
let is_rule_box box =
  match box.b_contents with
    | RuleBox -> true
    | _ -> false
  
(*
  Compound boxes contain a list of tuples (<x>, <y>, <box>).
*)
let new_compound_box width height depth contents = {
  b_width = width;
  b_height = height;
  b_depth = depth;
  b_contents = CompBox contents;
}
  
let is_compound_box box =
  match box.b_contents with
    | CompBox _ -> true
    | _ -> false
  
(* |wrap_in_compound_box <box>| puts <box> into a compound-box of the same size. *)
let wrap_in_compound_box box =
  if is_compound_box box then
    box
  else
    new_compound_box box.b_width box.b_height box.b_depth
      [PutBox (dim_zero, dim_zero, box)]
  
(*
  |add_to_compound_box <box> <gfx-cmds>| adds a list of graphics commands to <box>. If <box> is not
  a compound box then it is wrapped in one.
*)
let add_to_compound_box box gfx_cmds =
  match box.b_contents with
    | CompBox cmds ->
        new_compound_box box.b_width box.b_height box.b_depth (gfx_cmds @ cmds)
    | _ ->
        new_compound_box box.b_width box.b_height box.b_depth
          ((PutBox (dim_zero, dim_zero, box)) :: gfx_cmds)
  
(*
  |scale_box_horiz <box> <ratio>| and |scale_box_vert <box> <ratio>| scale <box> horizontally and
  vertically by <ratio>. The variants |scale_box_horiz_upto <box> <ratio>| and
  |scale_box_vert_upto <box> <ratio>| respect the maximal and minimal dimensions of <box>.
*)
let rec scale_box_horiz box ratio =
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          PutBox (dim_scale x ratio, y, scale_box_horiz b ratio)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box (dim_scale box.b_width ratio) box.b_height
            box.b_depth (List.map scale_graphics contents)
      | _ -> { box with b_width = dim_scale box.b_width ratio }
  
let rec scale_box_horiz_upto box ratio =
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          PutBox (dim_scale_upto x ratio, y, scale_box_horiz_upto b ratio)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box (dim_scale_upto box.b_width ratio) box.b_height
            box.b_depth (List.map scale_graphics contents)
      | _ -> { box with b_width = dim_scale_upto box.b_width ratio }
  
let rec scale_box_vert box ratio =
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          PutBox (x, dim_scale y ratio, scale_box_vert b ratio)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box box.b_width (dim_scale box.b_height ratio)
            (dim_scale box.b_depth ratio) (List.map scale_graphics contents)
      | _ ->
          { box with
              b_height = dim_scale box.b_height ratio;
              b_depth = dim_scale box.b_depth ratio }
  
let rec scale_box_vert_upto box ratio =
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          PutBox (x, dim_scale_upto y ratio, scale_box_vert_upto b ratio)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box box.b_width (dim_scale_upto box.b_height ratio)
            (dim_scale_upto box.b_depth ratio)
            (List.map scale_graphics contents)
      | _ ->
          {box with
             b_height = dim_scale_upto box.b_height ratio;
             b_depth = dim_scale_upto box.b_depth ratio}
  
let rec resize_box_horiz box width =
  let ratio = adjustment_ratio box.b_width width in
  let new_width =
    dim_shift_base box.b_width (sub_num width box.b_width.d_base) in
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          PutBox (dim_scale x ratio, y, scale_box_horiz b ratio)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box new_width box.b_height box.b_depth
            (List.map scale_graphics contents)
      | _ -> { (box) with b_width = new_width; }
  
let rec resize_box_vert box height depth =
  let height_ratio = adjustment_ratio box.b_height height in
  let depth_ratio = adjustment_ratio box.b_depth depth in
  let new_height =
    dim_shift_base box.b_height (sub_num height box.b_height.d_base) in
  let new_depth =
    dim_shift_base box.b_depth (sub_num depth box.b_depth.d_base) in
  let scale_graphics cmd =
    match cmd with
      | PutBox (x, y, b) ->
          if gt_num y.d_base num_zero then
            if ge_num (sub_num y.d_base b.b_depth.d_base) num_zero then
              PutBox (x, dim_scale y height_ratio,
                      scale_box_vert b height_ratio)
            else
              PutBox (x, dim_scale y height_ratio,
                      resize_box_vert b (dim_scale b.b_height height_ratio).d_base
                        (add_num (dim_scale y height_ratio).d_base
                           (dim_scale (dim_shift_base b.b_depth (minus_num y.d_base))
                              depth_ratio).
                           d_base))
          else
            if lt_num y.d_base num_zero then
              if le_num (add_num y.d_base b.b_height.d_base) num_zero then
                PutBox (x, dim_scale y depth_ratio,
                        scale_box_vert b depth_ratio)
              else
                PutBox (x, dim_scale y height_ratio,
                        resize_box_vert b
                          (sub_num
                             (dim_scale (dim_shift_base b.b_height y.d_base)
                                height_ratio).
                             d_base
                             (dim_scale y depth_ratio).d_base)
                          (dim_scale b.b_depth depth_ratio).d_base)
            else
              PutBox (x, dim_zero,
                      resize_box_vert b (dim_scale b.b_height height_ratio).d_base
                        (dim_scale b.b_depth depth_ratio).d_base)
      | _ -> cmd
  in
    match box.b_contents with
      | CompBox contents ->
          new_compound_box box.b_width new_height new_depth
            (List.map scale_graphics contents)
      | _ -> { (box) with b_height = new_height; b_depth = new_depth; }
  
let rec resize_box_horiz_upto box width =
  resize_box_horiz box (min width (dim_max_value box.b_width))
  
let rec resize_box_vert_upto box height depth =
  resize_box_vert box (min height (dim_max_value box.b_height))
    (min depth (dim_max_value box.b_depth))
  
(*
(* |shift_compound_vert <box> <amount>| shifts the contents of <box> upwards by <amount>. *)

value shift_compound_vert box amount = match box.b_contents with
[ CompBox contents -> do
  {
    let shift = fixed_dim amount;

    let shift_gfx cmd = match cmd with
    [ PutBox x y b -> PutBox x (dim_add y shift) b
    | _            -> cmd
    ];

    new_compound_box
      box.b_width
      (dim_add box.b_height shift)
      (dim_sub box.b_depth  shift)
      (List.map shift_gfx contents)
  }
| _ -> raise (Invalid_argument "Box.shift_comound_vert applied to non-compound box!")
];
*)
(* |shift_compound_box <box> <shift-x> <shift-y>| shifts the contents of <box>
   to the right by <shift-x> and upwards by <shift-y>. *)
let shift_compound_box box shift_x shift_y =
  match box.b_contents with
    | CompBox contents ->
        let dx = fixed_dim shift_x in
        let dy = fixed_dim shift_y in
        let shift_gfx cmd =
          begin
            match cmd with
              | PutBox (x, y, b) -> PutBox (dim_add x dx, dim_add y dy, b)
              | _ -> cmd
          end
        in
          new_compound_box (dim_add box.b_width dx) (dim_add box.b_height dy)
            (dim_sub box.b_depth dy) (List.map shift_gfx contents)
    | _ ->
        raise
          (Invalid_argument
             "Box.shift_compound_box applied to non-compound box!")
  
(*
  |make_phantom <box>| creates an empty box of the same size as <box>. |make_hphantom| and |make_vphantom|
  return boxes of the same width, resp. height and depth, but where the other dimension is zero.
*)
let make_phantom box =
  new_compound_box box.b_width box.b_height box.b_depth []
  
let make_hphantom box = new_compound_box box.b_width dim_zero dim_zero []
  
let make_vphantom box = new_compound_box dim_zero box.b_height box.b_depth []
  
(*
  Image boxes contain a reference to an external image file.
*)
let new_image_box width height file = {
  b_width = fixed_dim width;
  b_height = fixed_dim height;
  b_depth = dim_zero;
  b_contents = ImageBox file;
}
  
(*
  Math boxes are wrappers containing additional information needed to typeset math formulae.
  <code> denotes the type and <box> contains the original box.
*)
let new_math_box code box = {
  b_width = box.b_width;
  b_height = box.b_height;
  b_depth = box.b_depth;
  b_contents = MathBox (code, box);
}
  
let is_math_box box =
  match box.b_contents with
    | MathBox (_, _) -> true
    | _ -> false
  
let math_box_code box =
  match box.b_contents with
    | MathBox (c, _) -> c
    | _ -> NoMath
  
(*
  A break box indicates a point where a line-break can occur. <penalty> is the penalty for a break at this
  position, <hyph> indicates whether the break point was caused by a hyphenation. If <penalty> is
  |-infinite| the line is always broken at this position. <pre_break>, <post_break>, and <no_break>
  are lists of boxes which are inserted before and after a break, or if no break occurs.
*)
let new_break_box penalty hyph pre_break post_break no_break = {
  b_width = dim_zero;
  b_height = dim_zero;
  b_depth = dim_zero;
  b_contents = BreakBox (penalty, hyph, pre_break, post_break, no_break);
}
  
let forced_break_box = new_break_box (minus_num infinite) false [] [] []
  
let break_box_penalty box =
  match box.b_contents with
    | BreakBox (x, _, _, _, _) -> x
    | _ ->
        raise
          (Invalid_argument "Box.break_box_penalty applied to non-break box!")
  
let break_box_hyph box =
  match box.b_contents with
    | BreakBox (_, x, _, _, _) -> x
    | _ ->
        raise (Invalid_argument "Box.break_box_hyph applied to non-break box!")
  
let break_box_pre box =
  match box.b_contents with
    | BreakBox (_, _, x, _, _) -> x
    | _ ->
        raise (Invalid_argument "Box.break_box_pre applied to non-break box!")
  
let break_box_post box =
  match box.b_contents with
    | BreakBox (_, _, _, x, _) -> x
    | _ ->
        raise (Invalid_argument "Box.break_box_post applied to non-break box!")
  
let break_box_no box =
  match box.b_contents with
    | BreakBox (_, _, _, _, x) -> x
    | _ ->
        raise (Invalid_argument "Box.break_box_no applied to non-break box!")
  
let new_command_box cmd = {
  b_width    = dim_zero;
  b_height   = dim_zero;
  b_depth    = dim_zero;
  b_contents = CommandBox cmd;
}
  
let new_proc_box width height depth f = {
  b_width    = width;
  b_height   = height;
  b_depth    = depth;
  b_contents = ProcBox f;
}
  
(* |item_to_box <item>| converts a glyph_item into a box. *)
let rec simple_item_to_box item =
  match item with
    | `Glyph (g, f, t) -> new_glyph_box g f t
    | `Kern (x, y) -> new_kern_box x y
    | `Break (p, h, pre, post, no) ->
        new_break_box p h (Array.to_list (Array.map simple_item_to_box pre))
          (Array.to_list (Array.map simple_item_to_box post))
          (Array.to_list (Array.map simple_item_to_box no))
    | `Command c -> c
    | `Box b -> b
  
let rec extended_item_to_box item =
  match item with
    | `Glyph (g, (f, _), t) -> new_glyph_box g f t
    | `Kern (x, y) -> new_kern_box x y
    | `Break (p, h, pre, post, no) ->
        new_break_box p h (Array.to_list (Array.map extended_item_to_box pre))
          (Array.to_list (Array.map extended_item_to_box post))
          (Array.to_list (Array.map extended_item_to_box no))
    | `Command c -> c
    | `Box b -> b
  
(*
  |draw_box <page_info> <x> <y> <box>| converts <box> into a |simple_box|.
  While doing so it executes all `CallFunction commands and it expands all procedure boxes.
*)
let rec draw_box page_info x y box =
  match box.b_contents with
    | EmptyBox -> Empty
    | BreakBox (_, _, _, _, _) -> Empty
    | GlueBox (_, _) -> Empty
    | CharBox (c, f, t) -> FontMetric.draw_glyph f c t
    | RuleBox ->
        Group [PutBox (num_zero, box.b_depth.d_base,
                       Rule (box.b_width.d_base, add_num box.b_height.d_base box.b_depth.d_base))]
    | ImageBox file ->
        Image (box.b_width.d_base, box.b_height.d_base, file)
    | MathBox (_, b) -> draw_box page_info x y b
    | CompBox cmds ->
        let rec get_bg_colour cmds =
          begin
            match cmds with
              | [] -> []
              | SetBgColour c :: _ ->
                  [ SetColour c;
                    PutBox (num_zero, box.b_depth.d_base,
                            Rule (box.b_width.d_base,
                                  add_num box.b_height.d_base box.b_depth.d_base)) ]
              | _ :: cs -> get_bg_colour cs
          end
        in Group ((get_bg_colour cmds) @ (draw_gfx_cmds page_info x y cmds))
    | ProcBox f -> Group (draw_gfx_cmds page_info x y (f page_info (x, y) box))
    | CommandBox c ->
        begin
          match c with
            | `Special cmd -> Command cmd
            | `PageCmd cmd ->
                begin
                  match cmd with
                    | CallPageFunction f -> (f page_info (x, y); Empty)
                    | _ -> Empty
                end
            | _ -> Empty
        end

and draw_gfx_cmds page_info x y cmds =
  match cmds with
    | [] -> []
    | PutBox (dx, dy, b) :: cs ->
        begin
          match draw_box page_info (add_num x dx.d_base) (add_num y dy.d_base) b with
            | Empty -> draw_gfx_cmds page_info x y cs
            | box -> (PutBox (dx.d_base, dy.d_base, box)) :: (draw_gfx_cmds page_info x y cs)
        end
    | Draw (pc, p) :: cs -> (Draw (pc, convert_path p)) :: (draw_gfx_cmds page_info x y cs)
    | SetColour c :: cs -> (SetColour c) :: (draw_gfx_cmds page_info x y cs)
    | SetAlpha a :: cs -> (SetAlpha a) :: (draw_gfx_cmds page_info x y cs)
    | SetLineWidth w :: cs -> (SetLineWidth w) :: (draw_gfx_cmds page_info x y cs)
    | SetLineCap c :: cs -> (SetLineCap c) :: (draw_gfx_cmds page_info x y cs)
    | SetLineJoin j :: cs -> (SetLineJoin j) :: (draw_gfx_cmds page_info x y cs)
    | SetMiterLimit l :: cs -> (SetMiterLimit l) :: (draw_gfx_cmds page_info x y cs)
    | SetBgColour _ :: cs -> draw_gfx_cmds page_info x y cs

and convert_path p =
  List.map
    (fun (ax, ay, bx, by, cx, cy, dx, dy) ->
       ((ax.d_base), (ay.d_base), (bx.d_base), (by.d_base), (cx.d_base),
        (cy.d_base), (dx.d_base), (dy.d_base)))
    p
  
(*
  |discard_glue <boxes>| removes glue- and break-boxes from the start of the list <boxes>
  and collects all command-boxes encountered. It is usually called after a line- or page-break.
*)
let rec discard_glue boxes =
  let rec iter cmds boxes =
    match boxes with
      | [] -> ((List.rev cmds), [])
      | b :: bs ->
          begin
            match b.b_contents with
              | GlueBox (_, disc) ->
                  if disc then iter cmds bs else ((List.rev cmds), boxes)
              | BreakBox (_, _, _, _, []) -> iter cmds bs (* only break boxes where no-break is empty *)
              | EmptyBox -> iter cmds bs
              | _ ->
                  if is_real_box b then
                    ((List.rev cmds), boxes)
                  else
                    iter (b :: cmds) bs
          end
  in
    iter [] boxes
  
let remove_breaks boxes =
  let result = ListBuilder.make () in
  let rec iter boxes =
    match boxes with
      | [] -> ListBuilder.get result
      | b :: bs ->
          begin
            begin
              match b.b_contents with
                | BreakBox (_, _, _, _, n) -> ListBuilder.add_list result n
                | _ -> ListBuilder.add result b
            end;
            iter bs
          end
  in
    iter boxes

(*-----------------------------------------------------------------------*)
